home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 001-010 / amok06 / iffsupport / iffsupport.mod < prev    next >
Text File  |  1993-11-04  |  42KB  |  1,196 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    IFFSupport.mod
  3.     :Author.     Fridtjof Siebert
  4.     :Address.    Nobileweg 67, D-7-Stgt-40
  5.     :Phone.      0711/822509
  6.     :Shortcut.   [fbs]
  7.     :Version.    1.0
  8.     :Date.       27-Jul-88
  9.     :Copyright.  Shareware or PD, anyway you like. (I like Shareware better)
  10.     :Language.   Modula-II
  11.     :Translator. M2Amiga
  12.     :Imports.    LoadBody.asm [fbs]
  13.     :UpDate.     none.
  14.     :Contents.   PROCEDUREs für IFF-Bilder (Load, Save, ColorCycling).
  15.     :Remark.     Let's wave! The Cure. The Mission. Sisters of Mercy !!!
  16. ---------------------------------------------------------------------------*)
  17.  
  18. (* $S- $F- $N- $R- $V- this makes it a bit faster and shorter.             *)
  19. (* I hope that there are no more Errors, so these options can be cleared ! *)
  20.  
  21. IMPLEMENTATION MODULE IFFSupport;
  22.  
  23. FROM SYSTEM    IMPORT ADR, ADDRESS, SHIFT, BITSET, LONGSET, CAST, INLINE,
  24.                       REG;
  25. FROM Arts      IMPORT TermProcedure, Assert, BreakPoint;
  26.  
  27. FROM Exec      IMPORT AllocMem, FreeMem, MemReqs, MemReqSet, UByte,
  28.                       Interrupt, AddIntServer, RemIntServer, NodeType;
  29. FROM Dos       IMPORT FileHandlePtr, Open, Close, Read, oldFile, newFile,
  30.                       Write, DeleteFile, Seek, beginning;
  31. FROM Intuition IMPORT NewScreen, ScreenPtr, OpenScreen, CloseScreen,
  32.                       ScreenToBack, ScreenFlags, ScreenFlagSet,
  33.                       customScreen, MoveScreen, WindowPtr, OpenWindow,
  34.                       CloseWindow, IDCMPFlags, IDCMPFlagSet, WindowFlags,
  35.                       WindowFlagSet;
  36. FROM Graphics  IMPORT SetRGB4, RastPortPtr, BitMapPtr, ViewModes,
  37.                       ViewModeSet, BitMap, InitBitMap, AllocRaster,
  38.                       BltClear, FreeRaster, ViewPortPtr, RectanglePtr,
  39.                       Rectangle, GetRGB4;
  40. FROM GfxMacros IMPORT OffDisplay, OnDisplay;
  41. FROM Hardware  IMPORT vertb;
  42.  
  43. FROM Strings   IMPORT Compare, first, last;
  44.  
  45. FROM LoadBody  IMPORT LoadBody;
  46.  
  47. (*---------------------------------------------------------------------------
  48. !                                                                           !
  49. !                        Variables from Definition:                         !
  50. !                                                                           !
  51. -----------------------------------------------------------------------------
  52.  
  53. (*---------------------------  Types:  ------------------------------------*)
  54.  
  55. TYPE
  56.   IFFTitles = (BMHD,CMAP,GRAB,DEST,CAMG,CRNG,BODY,SPRT,CCRT,CMHD,DPPV);
  57.   IFFTitleSet = SET OF IFFTitles;
  58. (* SPRT,CCRT,CMHD,DPPV not implemented !!!                                 *)
  59.  
  60.   ViewTypes = (vt0,Ersy,Lace,LPen,vt4,vt5,vt6,vt7,Gaud,Color,DblPF,HoMod,
  61.                vt12,vt13,vt14,Hires,v16);
  62.   ViewTypeSet = SET OF ViewTypes;
  63. (* which ViewModes are selected *)
  64.  
  65. TYPE
  66.  
  67. (*-------------  The Structure that keeps all the data:  ------------------*)
  68. (* You don't have to understand all variables in this structure! Only some *)
  69. (* are important, like BMHD.width/height or CMAP.red[] etc. The other data *)
  70. (* is used by the Routines that are exported from this module,like DoCycle *)
  71. (* etc.                                                                    *)
  72.  
  73.   IFFInfoTypePtr = POINTER TO IFFInfoType;
  74.   IFFInfoType = RECORD
  75.   (* This contains all Data needed for a Picture *)
  76.  
  77. (*------  Which Data is availble:  ------*)
  78.     IFFTitle: IFFTitleSet;     (* all Sub-Records, whose equally named Flag*)
  79. (* is set here, contain readable data                                      *)
  80.  
  81. (*------  Information on BitMap:  ------*)
  82.     BMHD: RECORD
  83.  
  84.       width,height: INTEGER;   (* the Picture's Size                       *)
  85.       depth: UByte;            (* it's Depth (how many BitPlanes)          *)
  86.       left,top: INTEGER;       (* it's Location                            *)
  87.       masking: UByte;          (* Masking (see Documentation)              *)
  88.       transCol: INTEGER;       (* Transparent Color                        *)
  89.       xAspect,yAspect: UByte;  (* Verzerrung                               *)
  90.       scrnWidth,scrnHeight: INTEGER; (* The Image's Screen's Size          *)
  91.     END;
  92.  
  93. (*------  Information on Colors:  ------*)
  94.     CMAP: RECORD
  95.  
  96.       colorCnt: CARDINAL;      (* Number of Colors used                    *)
  97.       red,green,blue:   ARRAY[0..63] OF UByte;
  98.        (* the Colors (I hope for 6 Bitplanes to be possible anytime)       *)
  99.     END;
  100.  
  101. (*------  Information on HotSpot:  ------*)
  102.     GRAB: RECORD
  103.  
  104.       hotX,hotY: INTEGER;      (* Hot-Spot of this Image (if exists        *)
  105.     END;
  106.  
  107. (*------  Information on Destination-Bitmap:  ------*)
  108.     DEST: RECORD
  109.       depth: UByte;            (* number of Planes                         *)
  110.       planePick: CARDINAL;
  111.       planeOnOff: CARDINAL;    (* set or clear other Planes ?              *)
  112.       planeMask: CARDINAL;     (* planes to be changed                     *)
  113.     END;
  114.  
  115. (*------  Information on any Special ViewMode:  ------*)
  116.     CAMG: RECORD
  117.       viewType: ViewTypeSet;   (* ViewMode                                 *)
  118.     END;
  119.  
  120. (*------  Information on ColorCycling:  ------*)
  121.     CRNG: RECORD
  122.       count: CARDINAL;         (* Number of ColorCyclings                  *)
  123.       data: ARRAY[0..15] OF RECORD
  124.  
  125.         rate: INTEGER;         (* velocity, 800H is 60 per second          *)
  126.         on: BOOLEAN;           (* decide, wether CRNG is active or not     *)
  127.         forward: BOOLEAN;      (* Direction (DPaint)                       *)
  128.         low,high: UByte;       (* lower and upper Color of this Range      *)
  129.       END;
  130.     END;
  131. (*------  Internal Information:  ------*)
  132.     Internal: RECORD
  133.       CycleID: CARDINAL;       (* that's to distinguish different cyclings *)
  134.     END;
  135.   END;
  136.  
  137. (* That's been quite a complex Variable. If you wanna use it, do it this   *)
  138. (* way:                                                                    *)
  139. (* e.g. You wanna know, how Deep your Image is. Ça marche comme ça:        *)
  140. (* MyDepth := IFFInfo.BMHD.depth;                                          *)
  141. (* You can get the speed of the second Colorcycle this way:                *)
  142. (* speed := IFFInfo.CRNG.data[2].rate;                                     *)
  143.  
  144. (*--------------  That's the Variable, that contains all Data  ------------*)
  145. (* this should be imported to your Module to get the Data. Don't forget to *)
  146. (* save the data, e.g. to a variable of the same type. Everytime you load  *)
  147. (* a new IFF-File, the data is scratched !!! (i.e. the new data is written *)
  148. (* into this structure.)                                                   *)
  149.  
  150. VAR
  151.   IFFInfo: IFFInfoType;
  152.  
  153. (*--------------------  The NewScreen-Structure.  -------------------------*)
  154. (* this can be used to open the Screen, if dontopen is specified           *)
  155.  
  156. VAR
  157.   NuScreen: NewScreen;
  158.  
  159. (*--------------------  The NewWindow-Structure.  -------------------------*)
  160. (* this can be used to open the Window later. Don't forget to put Screen-  *)
  161. (* Ptr in NuWindow.screen !!!                                              *)
  162.  
  163. VAR
  164.   NuWindow: NewWindow;
  165.  
  166. (*------------------------   Error-Message:  -----------------------------*)
  167. (* IFFError contains Error-Number if ReadILBM or WriteILBM failed.        *)
  168.  
  169. TYPE
  170.   IFFErrors = (iffNoErr,iffOutofMem,iffOpenScreenfailed,iffOpenWindowfailed,
  171.                iffOpenfailed,iffWrongIFF,iffReadWritefailed);
  172. VAR
  173.   IFFError: IFFErrors;
  174.  
  175. *)
  176.  
  177. (*-------------------------------------------------------------------------*)
  178. (*                                                                         *)
  179. (*                     Internal Variables and Types:                       *)
  180. (*                                                                         *)
  181. (*-------------------------------------------------------------------------*)
  182.  
  183. CONST
  184.     MOVEMS = 48E7H; (* that's the 68000-Instruction MOVEM to save Registers*)
  185.     MOVEML = 4CDFH; (* that's MOVEM to load Registers                      *)
  186.  
  187. TYPE
  188.   CyclingInfo = RECORD                  (* Needed Data for Cycle-Interrupt *)
  189.     int: Interrupt;                     (* The Cycling's Interrupt         *)
  190.     VP: ViewPortPtr;                    (* The Cycling's ViewPort          *)
  191.     count: ARRAY[0..15] OF CARDINAL;    (* counts Cycling-Positions        *)
  192.     speedCnt: ARRAY[0..15] OF CARDINAL; (* counts Speed                    *)
  193.   END;
  194.  
  195. VAR
  196.   InH, OutH: FileHandlePtr;    (* Files                                    *)
  197.   i,j,k: LONGINT;              (* can be used by everything                *)
  198.   LineLength: LONGINT;         (* Bytes per Image-Line                     *)
  199.   LineWidth: LONGINT;          (* Bytes per Screen-Line                    *)
  200.   BM: BitMapPtr;               (* Screen's BitMap                          *)
  201.   Compression: BOOLEAN;        (* Decide, wether data is compressed or not *)
  202.   MaskPlane: BOOLEAN;          (* Is there a Mask-Plane ??                 *)
  203.   Buffer: ADDRESS;             (* Buffer for Reading / Writing             *)
  204.   TextBuffer: POINTER TO ARRAY[0..63] OF ARRAY[0..3] OF CHAR;
  205.   LONGBuffer: POINTER TO ARRAY[0..63] OF LONGCARD;
  206.   WORDBuffer: POINTER TO ARRAY[0..127] OF INTEGER;
  207.   BYTEBuffer: POINTER TO ARRAY[0..255] OF UByte;
  208.   len: LONGINT;                       (* Receives Length from Read/Write() *)
  209.   BitMaps: ARRAY[0..7] OF ADDRESS;    (* Pointer to Planes                 *)
  210.   Line,Plane: LONGINT;                (* Count Lines and Planes            *)
  211.   Location,Right: POINTER TO UByte;   (* Used while loading Buffer         *)
  212.   RQPos,RQLen: LONGCARD;              (* Used by QuickRead-Procedure       *)
  213.   RQBuffer: POINTER TO ARRAY[0..511] OF UByte; (* ReadQuick's Buffer       *)
  214.   Exit: BOOLEAN;                          (* Exit LOOP ?                   *)
  215.   NoErr: BOOLEAN;                         (* Error ?                       *)
  216.   CycleInfos: ARRAY[0..31] OF CyclingInfo;(* Colorcyclings                 *)
  217.   IntInfo: IFFInfoTypePtr;                (* Interrupt's IFFInfo           *)
  218.   IntNum: CARDINAL;                       (* Interrupt's ID                *)
  219.   IntCount,IntCount2,IntCount3: CARDINAL; (* used by Interrupt fo Cycling  *)
  220.   ColorConv: LONGCARD;                    (* converting Colors             *)
  221.   Address: ADDRESS;
  222.   FileLength,BodyPos,BodyLength: LONGINT; (* Position and Length in File   *)
  223.   ShiftBuffer: ARRAY[0..31] OF LONGSET;   (* Buffer for Shifting Graphic   *)
  224.   ShiftSource: POINTER TO ARRAY[0..31] OF LONGSET; (* Points into Planes   *)
  225.   NeedToShift: BOOLEAN;                   (* is shifting really needed ?   *)
  226.   ShiftWidth,BitsToShift: CARDINAL;  (* how far and how many Bits to shift *)
  227.   TrueLeftOffset,TrueWidth: INTEGER;      (* Word-aligned Offset & Width   *)
  228.  
  229.  
  230. (*-----------  Procedure called by machinecode to get Data:  --------------*)
  231.  
  232. PROCEDURE Read512();
  233.  
  234. BEGIN
  235.   len := Read(InH,RQBuffer,512);
  236. END Read512;
  237.  
  238. (*-------------------------------------------------------------------------*)
  239. (*                                                                         *)
  240. (*                          R e a d  I L B M :                             *)
  241. (*                                                                         *)
  242. (*-------------------------------------------------------------------------*)
  243.  
  244. (*
  245. TYPE
  246.   ReadILBMFlags = (front,visible,dontopen,window);
  247.   ReadILBMFlagSet = SET OF ReadILBMFlags;
  248. *)
  249.  
  250. PROCEDURE ReadILBM(name: ARRAY OF CHAR; Flags: ReadILBMFlagSet;
  251.                    VAR Screen: ScreenPtr; VAR Window: WindowPtr): BOOLEAN;
  252. (* ReadILBM() lädt ein IFF-Bild und öffnet das geladene Bild als Screen.   *)
  253. (* Name: The IFF-Filename                                                  *)
  254. (* Flags:                                                                  *)
  255. (*  -front: decides whether Screen is first or last one while loading      *)
  256. (*  -visible: decides if display should be turned off (that's faster)      *)
  257. (*  -dontopen: avoids to open the Screen. The Returned value is NIL. The   *)
  258. (*     BitMap of the loaded Imagery can be found in NuScreen.customBitMap. *)
  259. (*     Don't forget to free the image's Memory if it's no more needed and  *)
  260. (*     the Memory needed for the BitMap-Structure.                         *)
  261. (*  -window: if set, an Window of the same size as the Image is opened.    *)
  262. (*           So, Gadgets etc. can be added to it.                          *)
  263. (* Screen: Pointer to Screen-structure of opened Screen                    *)
  264. (* Window: Pointer to the opened Window or NIL if window isn't set.        *)
  265. (* Result: FALSE if error occured. Then there's no Screen opened.          *)
  266.  
  267. PROCEDURE OpenScrn();
  268. (* this initializes the Screen, Window and Bitmap, if they're needed.      *)
  269. (* Screen and Window are opened.                                           *)
  270.  
  271.   BEGIN
  272.     WITH NuScreen DO
  273.       width := IFFInfo.BMHD.scrnWidth;
  274.       IF width<IFFInfo.BMHD.width THEN
  275.         width := IFFInfo.BMHD.width;
  276.       END;
  277.       height := IFFInfo.BMHD.scrnHeight;
  278.       IF height<IFFInfo.BMHD.height THEN
  279.         height := IFFInfo.BMHD.height;
  280.       END;
  281.       leftEdge := IFFInfo.BMHD.left;
  282.       topEdge := IFFInfo.BMHD.top;
  283.       depth := IFFInfo.BMHD.depth;
  284.       viewModes := ViewModeSet{};
  285.       IF (width>400) AND (depth<5) THEN INCL(viewModes,hires) END;
  286.       IF height>300 THEN INCL(viewModes,lace) END;
  287.       WITH IFFInfo.CAMG DO
  288.         IF (Lace  IN viewType) THEN INCL(viewModes,lace  ) END;
  289.         IF (HoMod IN viewType) THEN INCL(viewModes,ham   ) END;
  290.         IF (Hires IN viewType) THEN INCL(viewModes,hires ) END;
  291.         IF (DblPF IN viewType) THEN INCL(viewModes,dualpf) END;
  292.         IF (DblPF IN viewType) AND (HoMod IN viewType) AND (depth=6) THEN
  293.           viewModes := ViewModeSet{extraHalfbrite};
  294.         END;
  295.       END;
  296.       detailPen := 0; blockPen := 0;
  297.       type := customScreen+ScreenFlagSet{screenQuiet};
  298.       font := NIL;
  299.       defaultTitle := NIL;
  300.       gadgets := NIL;
  301.       customBitMap := NIL;
  302.       IF NOT(front IN Flags) THEN topEdge := 600 END;
  303.     END;
  304.     IF dontopen IN Flags THEN
  305.       INCL(NuScreen.type,customBitMap);
  306.       WITH NuScreen DO
  307.         customBitMap := AllocMem(SIZE(BitMap),MemReqSet{public});
  308.         InitBitMap(customBitMap^,depth,width,height);
  309.         i:=0;
  310.         REPEAT
  311.           customBitMap^.planes[i] := AllocRaster(width,height);
  312.           BitMaps[i] := customBitMap^.planes[i];
  313.           IF BitMaps[i]=NIL THEN
  314.             NoErr:=FALSE;
  315.             IFFError := iffOutofMem;
  316.           ELSE
  317.             BltClear(BitMaps[i],width DIV 8 * height,0);
  318.           END;
  319.           INC(i);
  320.         UNTIL (i=depth) OR NOT(NoErr);
  321.         IF NOT(NoErr) THEN (* error: give allocated Mem back: *)
  322.           WHILE i>1 DO
  323.             DEC(i);
  324.             FreeRaster(BitMaps[i],width,height);
  325.           END;
  326.         END;
  327.       END;
  328.     ELSE
  329.       Screen := OpenScreen(NuScreen);
  330.       IF Screen=NIL THEN
  331.         NoErr := FALSE;
  332.         IFFError := iffOpenScreenfailed;
  333.       ELSE
  334.         IF NOT(front IN Flags) THEN
  335.           ScreenToBack(Screen);
  336.           MoveScreen(Screen,0,-600);
  337.         END;
  338.         BM := Screen^.rastPort.bitMap;
  339.         FOR i:=0 TO NuScreen.depth-1 DO
  340.           BitMaps[i] := BM^.planes[i];
  341.         END;
  342.         WITH IFFInfo.CMAP DO
  343.           FOR i:=0 TO colorCnt-1 DO
  344.             SetRGB4(ADR(Screen^.viewPort),i,red[i],green[i],blue[i]);
  345.           END;
  346.         END;
  347.       END;
  348.     END;
  349.     WITH NuWindow DO
  350.       leftEdge := 0;
  351.       topEdge := 0;
  352.       width := IFFInfo.BMHD.width;
  353.       height := IFFInfo.BMHD.height;
  354.       detailPen := 1;
  355.       blockPen := 0;
  356.       idcmpFlags := IDCMPFlagSet{};
  357.       flags := WindowFlagSet{borderless,noCareRefresh};
  358.       firstGadget := NIL;
  359.       checkMark := NIL;
  360.       title := NIL;
  361.       screen := Screen;
  362.       bitMap := NIL;
  363.       type := customScreen;
  364.     END;
  365.     IF (window IN Flags) AND (Screen#NIL) THEN
  366.       Window := OpenWindow(NuWindow);
  367.       IF Window=NIL THEN
  368.         CloseScreen(Screen);
  369.         Screen := NIL;
  370.         NoErr := FALSE;
  371.         IFFError := iffOpenWindowfailed;
  372.       END;
  373.     END;
  374.     IF NOT(visible IN Flags) THEN OffDisplay() END;
  375.   END OpenScrn;
  376.  
  377. PROCEDURE ReadQuick(To: ADDRESS; Count: CARDINAL);
  378.  
  379.   VAR
  380.     ToPtr: POINTER TO ARRAY[0..9999] OF UByte;
  381.     i: CARDINAL;
  382.  
  383.   BEGIN
  384.     ToPtr := To;
  385.     i := 0;
  386.     REPEAT
  387.       IF RQPos=RQLen THEN
  388.         RQLen := Read(InH,RQBuffer,512);
  389.         RQPos := 0;
  390.       END;
  391.       ToPtr^[i] := ORD(RQBuffer^[RQPos]);
  392.       INC(RQPos); INC(i);
  393.     UNTIL i=Count;
  394.   END ReadQuick;
  395.  
  396. BEGIN
  397.   IFFInfo.IFFTitle := IFFTitleSet{};
  398.  
  399.   IF NOT(visible IN Flags) THEN OffDisplay() END;
  400.   NoErr := TRUE; IFFError := iffNoErr;
  401.   Screen := NIL; Window := NIL;
  402.   RQPos := 0; RQLen := 0;
  403.  
  404.   InH := Open(ADR(name),oldFile);
  405.   IF InH=NIL THEN
  406.     NoErr := FALSE;
  407.     IFFError := iffOpenfailed;
  408.   END;
  409.  
  410.   IF NoErr THEN
  411.  
  412. (*------  File Header:  ------*)
  413.  
  414.     len := Read(InH,Buffer,12);
  415.     IF (len=NIL) OR (Compare(TextBuffer^[0],first,4,"FORM",TRUE)#0) OR
  416.        (Compare(TextBuffer^[2],first,4,"ILBM",TRUE)#0) THEN
  417.       NoErr := FALSE;
  418.       IFFError := iffReadWritefailed;
  419.     END;
  420.  
  421.     Exit := FALSE;
  422.  
  423. (*------  Main Loop:  ------*)
  424.  
  425.     WHILE NoErr AND NOT(Exit) DO
  426.       len := Read(InH,Buffer,4);
  427.  
  428.   (*------  BMHD:  ------*)
  429.  
  430.       IF Compare(TextBuffer^[0],first,4,"BMHD",TRUE)=0 THEN
  431.         INCL(IFFInfo.IFFTitle,BMHD);
  432.         len := Read(InH,Buffer,4);
  433.         len := Read(InH,Buffer,LONGBuffer^[0]);
  434.         WITH IFFInfo.BMHD DO
  435.           width     := WORDBuffer^[0];
  436.           height    := WORDBuffer^[1];
  437.           left      := WORDBuffer^[2];
  438.           top       := WORDBuffer^[3];
  439.           depth     := BYTEBuffer^[8];
  440.           masking   := BYTEBuffer^[9];
  441.           MaskPlane := masking=1;
  442.           Compression := BYTEBuffer^[10]=1;
  443.           transCol  := WORDBuffer^[6];
  444.           xAspect   := BYTEBuffer^[14];
  445.           yAspect   := BYTEBuffer^[15];
  446.           scrnWidth := WORDBuffer^[8];
  447.           scrnHeight:= WORDBuffer^[9];
  448.         END;
  449.  
  450.   (*------  CMAP:  ------*)
  451.  
  452.       ELSIF Compare(TextBuffer^[0],first,4,"CMAP",TRUE)=0 THEN
  453.         INCL(IFFInfo.IFFTitle,CMAP);
  454.         len := Read(InH,Buffer,4);
  455.         i := LONGBuffer^[0];
  456.         len := Read(InH,Buffer,i);
  457.         WITH IFFInfo.CMAP DO
  458.           colorCnt := i DIV 3;
  459.           j := 0;
  460.           FOR k:=0 TO colorCnt-1 DO
  461.             red  [k] := BYTEBuffer^[j  ] DIV 16;
  462.             green[k] := BYTEBuffer^[j+1] DIV 16;
  463.             blue [k] := BYTEBuffer^[j+2] DIV 16;
  464.             INC(j,3);
  465.           END;
  466.         END;
  467.  
  468.   (*------  CAMG:  ------*)
  469.  
  470.       ELSIF Compare(TextBuffer^[0],first,4,"CAMG",TRUE)=0 THEN
  471.         INCL(IFFInfo.IFFTitle,CAMG);
  472.         len := Read(InH,Buffer,8);
  473.         IFFInfo.CAMG.viewType := CAST(ViewTypeSet,LONGBuffer^[1]);
  474.  
  475.   (*------  GRAB:  ------*)
  476.  
  477.       ELSIF Compare(TextBuffer^[0],first,4,"GRAB",TRUE)=0 THEN
  478.         INCL(IFFInfo.IFFTitle,GRAB);
  479.         len := Read(InH,Buffer,8);
  480.         IFFInfo.GRAB.hotX := WORDBuffer^[2];
  481.         IFFInfo.GRAB.hotY := WORDBuffer^[3];
  482.  
  483.   (*------  DEST:  ------*)
  484.  
  485.       ELSIF Compare(TextBuffer^[0],first,4,"DEST",TRUE)=0 THEN
  486.         INCL(IFFInfo.IFFTitle,DEST);
  487.         len := Read(InH,Buffer,12);
  488.         WITH IFFInfo.DEST DO
  489.           depth      := BYTEBuffer^[4];
  490.           planePick  := WORDBuffer^[3];
  491.           planeOnOff := WORDBuffer^[4];
  492.           planeMask  := WORDBuffer^[5];
  493.         END;
  494.  
  495.   (*------  CRNG:  ------*)
  496.  
  497.       ELSIF Compare(TextBuffer^[0],first,4,"CRNG",TRUE)=0 THEN
  498.         IF NOT(CRNG IN IFFInfo.IFFTitle) THEN
  499.           IFFInfo.CRNG.count := 0;
  500.         END;
  501.         INCL(IFFInfo.IFFTitle,CRNG);
  502.         len := Read(InH,Buffer,12);
  503.         WITH IFFInfo.CRNG.data[IFFInfo.CRNG.count] DO
  504.           rate := WORDBuffer^[3];
  505.           on   := 0 IN CAST(BITSET,WORDBuffer^[4]);
  506.           forward := NOT(1 IN CAST(BITSET,WORDBuffer^[4]));
  507.           low  := BYTEBuffer^[10];
  508.           high := BYTEBuffer^[11];
  509. (* this line is only to identify illegal data, that some IFF-Files contain:*)
  510.           on := on AND (low<IFFInfo.CMAP.colorCnt)
  511.                 AND (high<IFFInfo.CMAP.colorCnt);
  512.         END;
  513.         INC(IFFInfo.CRNG.count);
  514.  
  515.   (*------  BODY:  ------*)
  516.  
  517.       ELSIF Compare(TextBuffer^[0],first,4,"BODY",TRUE)=0 THEN
  518.         INCL(IFFInfo.IFFTitle,BODY);
  519.         OpenScrn();
  520.         IF NoErr THEN
  521.           len := Read(InH,Buffer,4);
  522.           LineLength := CAST(INTEGER,CAST(BITSET,IFFInfo.BMHD.width+15)
  523.                              * {4..15}) DIV 8;
  524.           LineWidth  := NuScreen.width DIV 8;
  525.           IF Compression THEN
  526.           (*------  let's load the BitMap's Data:  ------*)
  527.             LoadBody(Read512, RQBuffer, ADR(BitMaps[0]), LineLength,
  528.                      LineWidth, IFFInfo.BMHD.height, NuScreen.depth,
  529.                      MaskPlane); (* this does all the work very quickly *)
  530.           ELSE   (* not compressed *)
  531.           (*------  to load uncompressed Images is less time-critical: *)
  532.             FOR Line := 0 TO IFFInfo.BMHD.height-1 DO
  533.               FOR Plane := 0 TO NuScreen.depth-1 DO
  534.                 ReadQuick(BitMaps[Plane]+ LineWidth*Line,LineLength);
  535.               END;
  536.               IF MaskPlane THEN
  537.                 ReadQuick(Buffer,LineLength);
  538.               END;
  539.             END;
  540.           END;
  541.         END; (* IF NoErr *)
  542.         Exit := TRUE;
  543.  
  544.   (*------  Ignore unknown data:  ------*)
  545.  
  546.       ELSE
  547.         len := Read(InH,Buffer,4);
  548.         i := LONGBuffer^[0];
  549.         WHILE i>256 DO
  550.           len := Read(InH,Buffer,256);
  551.           DEC(i,256);
  552.         END;
  553.         len := Read(InH,Buffer,i);
  554.       END;
  555.  
  556.   (*------  Detect ReadError:  ------*)
  557.  
  558.       IF len=0 THEN
  559.         NoErr := FALSE;
  560.         IFFError := iffReadWritefailed;
  561.       END;
  562.  
  563.     END;   (* WHILE NOT(Exit DO *)
  564.   END;   (* IF NoErr *)
  565.  
  566.   IF InH#NIL THEN Close(InH); InH := NIL; END;
  567.   IF NOT(NoErr) THEN
  568.     IF Window#NIL THEN CloseWindow(Window) END;
  569.     IF Screen#NIL THEN CloseScreen(Screen) END;
  570.   END;
  571.   OnDisplay();
  572.   RETURN NoErr;
  573. END ReadILBM; (* that's it *)
  574.  
  575. (*---------------  Procedures for ColorCycling:  --------------------------*)
  576.  
  577. PROCEDURE CycleInterrupt();
  578.  
  579. BEGIN
  580.   INLINE(MOVEMS,3F3EH);
  581.  
  582.   IntInfo := ADDRESS(REG(9));
  583.   IF CRNG IN IntInfo^.IFFTitle THEN
  584.     IntNum := IntInfo^.Internal.CycleID;
  585.     WITH CycleInfos[IntNum] DO
  586.       IntCount := 0;
  587.       WHILE IntCount<IntInfo^.CRNG.count DO
  588.         WITH IntInfo^.CRNG.data[IntCount] DO
  589.           IF on THEN
  590.             INC(speedCnt[IntCount],rate);
  591.             IF speedCnt[IntCount]>=4000H THEN
  592.               (* this 4000H should have been 8000H, but then it's to slow. *)
  593.               (* dont know why, but this way, it works correctly           *)
  594.               DEC(speedCnt[IntCount],4000H);
  595.               IF forward THEN
  596.                 IF count[IntCount]<=low THEN
  597.                   count[IntCount]:=high;
  598.                 ELSE
  599.                   DEC(count[IntCount]);
  600.                 END;
  601.               ELSE
  602.                 IF count[IntCount]>=high THEN
  603.                   count[IntCount]:=low;
  604.                 ELSE
  605.                   INC(count[IntCount]);
  606.                 END;
  607.               END;
  608.               IntCount3 := count[IntCount];
  609.               IntCount2 := low;
  610.               WHILE IntCount2<=high DO
  611.                 SetRGB4(VP,IntCount2,IntInfo^.CMAP.red[IntCount3],
  612.                                      IntInfo^.CMAP.green[IntCount3],
  613.                                      IntInfo^.CMAP.blue[IntCount3]);
  614.                 INC(IntCount3);
  615.                 IF IntCount3>high THEN IntCount3:=low END;
  616.                 INC(IntCount2);
  617.               END;
  618.             END;
  619.           END;
  620.         END;
  621.         INC(IntCount);
  622.       END;
  623.     END;
  624.   END;
  625.  
  626.   INLINE(MOVEML,7CFCH);
  627. END CycleInterrupt;
  628.  
  629. (*-------------------------------------------------------------------------*)
  630. (*                                                                         *)
  631. (*                         Start Colorcycling:                             *)
  632. (*                                                                         *)
  633. (*-------------------------------------------------------------------------*)
  634.  
  635. PROCEDURE DoCycle(Info: IFFInfoTypePtr; Screen: ScreenPtr): BOOLEAN;
  636. (* this creates an interrupt, that does cycling. You needn't worry,        *)
  637. (* whether there's cycling data or not. Don't forget to call EndCycle to   *)
  638. (* remove the Cycling-Interrupt !!!                                        *)
  639. (* If result is false, any error occured. Don't call EndCycle in this case!*)
  640.  
  641. BEGIN
  642.   i:=0;
  643.   LOOP
  644.     IF CycleInfos[i].VP=NIL THEN EXIT END;
  645.     INC(i);
  646.     IF i=32 THEN RETURN FALSE END;
  647.   END;
  648.   Info^.Internal.CycleID := i;
  649.   WITH CycleInfos[i] DO
  650.     VP := ADR(Screen^.viewPort);
  651.     IF CRNG IN Info^.IFFTitle THEN
  652.       FOR j:=0 TO Info^.CRNG.count-1 DO
  653.         count[j] := Info^.CRNG.data[j].low;
  654.         speedCnt[j] := 0;
  655.       END;
  656.     END;
  657.     WITH int DO
  658.       node.type := interrupt;
  659.       node.pri  := -60;
  660.       node.name := NIL;
  661.       data := Info;
  662.       code := ADR(CycleInterrupt);
  663.     END;
  664.     AddIntServer(vertb,ADR(int));
  665.   END;
  666.   RETURN TRUE;
  667. END DoCycle;
  668.  
  669. (*-------------------------------------------------------------------------*)
  670. (*                                                                         *)
  671. (*                         End Colorcycling:                               *)
  672. (*                                                                         *)
  673. (*-------------------------------------------------------------------------*)
  674.  
  675. PROCEDURE EndCycle(Info: IFFInfoTypePtr);
  676. (* remove cycling-Interrupt                                                *)
  677.  
  678. BEGIN
  679.   i := Info^.Internal.CycleID;
  680.   RemIntServer(vertb,ADR(CycleInfos[i].int));
  681.   CycleInfos[i].VP := NIL;
  682. END EndCycle;
  683.  
  684. (*-------------------------------------------------------------------------*)
  685. (*                                                                         *)
  686. (*              Initialize BMHD, CMAP & CAMG for WriteILBMAll:             *)
  687. (*                                                                         *)
  688. (*-------------------------------------------------------------------------*)
  689.  
  690. PROCEDURE InitIFFInfo(Info: IFFInfoTypePtr;
  691.                       RP: RastPortPtr;
  692.                       VP: ViewPortPtr;
  693.                       Rect: RectanglePtr);
  694.  
  695. (* Initialize essential parts of IFFInfoType-Variable.                     *)
  696. (* This can be used to simplify the initialization of an IFFInfoType       *)
  697. (* RP:         RastPort containing the BitMap etc.                         *)
  698. (* VP:         ViewPort containing the Colors, ViewModes etc.              *)
  699. (* Rect:       The Rectangle Region in your RastPort, that should be saved *)
  700. (*             or NIL to save hole RastPort                                *)
  701.  
  702. VAR
  703.   DefaultRect: Rectangle;
  704.  
  705. BEGIN
  706.  
  707.   WITH RP^ DO
  708.     IF Rect=NIL THEN
  709.       Rect := ADR(DefaultRect);
  710.       WITH DefaultRect DO
  711.         minX := 0; minY := 0;
  712.         maxX := bitMap^.bytesPerRow * 8 - 1;
  713.         maxY := bitMap^.rows - 1;
  714.       END;
  715.     END;
  716.  
  717. (*------  Initialize BMHD:  ------*)
  718.  
  719.     WITH Info^.BMHD DO
  720.       width := Rect^.maxX - Rect^.minX + 1;
  721.       height := Rect^.maxY - Rect^.minY + 1;
  722.       depth := bitMap^.depth;
  723.       left := 0;
  724.       top := 0;
  725.       masking := 0;
  726.       transCol := 0;
  727.       scrnWidth := bitMap^.bytesPerRow * 8;
  728.       scrnHeight := bitMap^.rows;
  729.       IF scrnWidth<640 THEN
  730.         xAspect := 10;
  731.       ELSE
  732.         xAspect := 5;
  733.       END;
  734.       IF scrnHeight>400 THEN
  735.         INC(xAspect,xAspect);
  736.       END;
  737.       yAspect := 11;
  738.     END;
  739.   END;   (* WITH RP^ DO *)
  740.  
  741. (*------  Initialize CMAP:  ------*)
  742.  
  743.   WITH Info^.CMAP DO
  744.     colorCnt := VP^.colorMap^.count;
  745.     FOR i := 0 TO colorCnt-1 DO
  746.       ColorConv := GetRGB4(VP^.colorMap,i);
  747.       IF ColorConv>0FFFH THEN ColorConv := 0 END;
  748.       red  [i] := UByte(CAST(CARDINAL,CAST(BITSET,
  749.                          CARDINAL(SHIFT(ColorConv,-8))) * {0..3}));
  750.       green[i] := UByte(CAST(CARDINAL,CAST(BITSET,
  751.                          CARDINAL(SHIFT(ColorConv,-4))) * {0..3}));
  752.       blue [i] := UByte(CAST(CARDINAL,CAST(BITSET,
  753.                          CARDINAL(ColorConv)) * {0..3}));
  754.     END;
  755.   END;
  756.  
  757. (*------  Initialize CAMG:  ------*)
  758.  
  759.   WITH Info^.CAMG DO
  760.     viewType := ViewTypeSet{};
  761.     IF lace           IN VP^.modes THEN INCL(viewType,Lace)  END;
  762.     IF hires          IN VP^.modes THEN INCL(viewType,Hires) END;
  763.     IF dualpf         IN VP^.modes THEN INCL(viewType,DblPF) END;
  764.     IF ham            IN VP^.modes THEN INCL(viewType,HoMod) END;
  765.     IF extraHalfbrite IN VP^.modes THEN
  766.       viewType := ViewTypeSet{HoMod,DblPF};
  767.     END;
  768.   END;
  769.  
  770.   Info^.IFFTitle := IFFTitleSet{BMHD,CMAP,CAMG};
  771.  
  772. END InitIFFInfo;
  773.  
  774.  
  775. (*-------------------------------------------------------------------------*)
  776. (*                                                                         *)
  777. (*                        Save an ILBM-File:                               *)
  778. (*                                                                         *)
  779. (*-------------------------------------------------------------------------*)
  780.  
  781. PROCEDURE WriteILBMAll(Name: ARRAY OF CHAR;
  782.                        Info: IFFInfoTypePtr;
  783.                        BM: BitMapPtr;
  784.                        FirstLine, LeftOffset: INTEGER;
  785.                        CompressIt: BOOLEAN): BOOLEAN;
  786. (* Saves IFF-File named Name                                               *)
  787. (* This is a very Low-Level Procedure. You should use it to save Pictures  *)
  788. (* with ColorCycling and things like that.                                 *)
  789. (* To save Screens, Windows or so use the other Procedures !               *)
  790. (* Info^.IFFTitle must have set the Flags of all initialized Sub-Records   *)
  791. (* BM:            contains the Graphicdata. In fact BM doesn't have to be  *)
  792. (*                part of a RastPort. It can be used to save a MaskPlane.  *)
  793. (*                Then BM has to contain one extra Plane and BM^.depth and *)
  794. (*                Info^.BMHD.depth have to be increased by 1.              *)
  795. (* FirstLine:     is the TopEdge within BM                                 *)
  796. (* LeftOffset:    is the LeftEdge within BM.                               *)
  797. (* an examble to call this can be is the Implementation of WriteILBM()     *)
  798.  
  799.   TYPE
  800.     BufPtr = POINTER TO ARRAY[0..255] OF UByte;
  801.  
  802.   PROCEDURE Compress(At: BufPtr; Length: LONGINT): LONGINT;
  803.   (* This compresses a line starting at At that is Length Bytes long.      *)
  804.   (* The compressed Data is Written into Buffer and saved to OutH.         *)
  805.   (* Result is Legth of Compressed Data or zero if Error while writing     *)
  806.  
  807.   VAR
  808.     at, last, out, len: LONGINT;
  809.  
  810.     PROCEDURE CopyUnchanged(from,to: LONGINT);
  811.  
  812.     BEGIN
  813.       BYTEBuffer^[out] := to - from - 1;
  814.       INC(out);
  815.       WHILE from<to DO
  816.         BYTEBuffer^[out] := At^[from];
  817.         INC(out);
  818.         INC(from);
  819.       END;
  820.     END CopyUnchanged;
  821.  
  822.   BEGIN
  823.     at := 1;
  824.     last := 0;
  825.     out := 0;
  826.     LOOP
  827.       IF (At^[at]=At^[at-1]) AND (At^[at]=At^[at+1]) AND (at+1<Length) THEN
  828.         IF last#at-1 THEN
  829.           CopyUnchanged(last,at-1);
  830.         END;
  831.         last := at-1;
  832.       (*------  Repeat Byte:  ------*)
  833.         REPEAT
  834.           INC(at)
  835.         UNTIL (At^[last]#At^[at]) OR (at-last=128) OR (at=Length);
  836.         BYTEBuffer^[out] := 257+last-at;
  837.         INC(out);
  838.         BYTEBuffer^[out] := At^[last];
  839.         INC(out);
  840.         last := at;
  841.         IF at=Length THEN EXIT END;
  842.       ELSIF (at-last)=128 THEN
  843.       (*------  Copy Unchanged:  ------*)
  844.         CopyUnchanged(last,at);
  845.         last := at;
  846.       END;
  847.       INC(at);
  848.       IF at=Length THEN EXIT END;
  849.     END;
  850.     IF at#last THEN CopyUnchanged(last,at) END;
  851.     len := Write(OutH,Buffer,out);
  852.     INC(BodyLength,out);
  853.     INC(FileLength,out);
  854.     RETURN len;
  855.   END Compress;
  856.  
  857.   PROCEDURE ShiftLine(At: ADDRESS);
  858.   (* This shifts BitsToShift from At ShiftWidth left and stores them in    *)
  859.   (* ShiftBuffer.                                                          *)
  860.  
  861.   VAR
  862.     sourcelong,sourcebit,destlong,destbit: CARDINAL;
  863.  
  864.   BEGIN
  865.     ShiftSource := At;
  866.     sourcelong := 0;
  867.     sourcebit := 31-ShiftWidth;
  868.     destlong := 0;
  869.     destbit := 31;
  870.     ShiftBuffer[0] := LONGSET{};
  871.     FOR i:=1 TO BitsToShift DO
  872.       IF sourcebit IN ShiftSource^[sourcelong] THEN
  873.         INCL(ShiftBuffer[destlong],destbit);
  874.       END;
  875.       IF sourcebit=0 THEN
  876.         sourcebit := 31;
  877.         INC(sourcelong);
  878.       ELSE
  879.         DEC(sourcebit);
  880.       END;
  881.       IF destbit=0 THEN
  882.         destbit := 31;
  883.         INC(destlong);
  884.         ShiftBuffer[destlong] := LONGSET{};
  885.       ELSE
  886.         DEC(destbit);
  887.       END;
  888.     END;
  889.   END ShiftLine;
  890.  
  891. (*------  MAIN:  ------*)
  892.  
  893. BEGIN
  894.  
  895. (*------  Open:  ------*)
  896.  
  897.   OutH := Open(ADR(Name),newFile);
  898.   IF OutH=NIL THEN
  899.     IFFError := iffOpenfailed;
  900.     RETURN FALSE;
  901.   END;
  902.   TextBuffer^[0] := "FORM";
  903.   TextBuffer^[2] := "ILBM";
  904.   len := Write(OutH,TextBuffer,12);
  905.   IF len#12 THEN
  906.     Close(OutH);
  907.     OutH := NIL;
  908.     len := DeleteFile(ADR(Name));
  909.     IFFError := iffReadWritefailed;
  910.     RETURN FALSE;
  911.   END;
  912.   FileLength := 4;
  913.  
  914. (*------  BMHD:  ------*)
  915.  
  916.   IF BMHD IN Info^.IFFTitle THEN   (* in fact, BMHD MUST be set *)
  917.     WITH Info^ DO
  918.       TextBuffer^[ 0] := "BMHD";
  919.       LONGBuffer^[ 1] := 20;              (* Length *)
  920.       WORDBuffer^[ 4] := BMHD.width;
  921.       WORDBuffer^[ 5] := BMHD.height;
  922.       WORDBuffer^[ 6] := BMHD.left;
  923.       WORDBuffer^[ 7] := BMHD.top;
  924.       BYTEBuffer^[16] := BMHD.depth;
  925.       BYTEBuffer^[17] := BMHD.masking;    (* special masking *)
  926.       IF CompressIt THEN                  (* compression *)
  927.         BYTEBuffer^[18] := 1;
  928.       ELSE
  929.         BYTEBuffer^[18] := 0;
  930.       END;
  931.       BYTEBuffer^[19] := 0;               (* pad *)
  932.       WORDBuffer^[10] := BMHD.transCol; (* transparent Color *)
  933.       BYTEBuffer^[22] := BMHD.xAspect;
  934.       BYTEBuffer^[23] := BMHD.yAspect;
  935.       WORDBuffer^[12] := BMHD.scrnWidth;
  936.       WORDBuffer^[13] := BMHD.scrnHeight;
  937.       len := Write(OutH,Buffer,28);
  938.       INC(FileLength,28);
  939.     END;
  940.   END;
  941.  
  942. (*------  CMAP:  ------*)
  943.  
  944.   IF CMAP IN Info^.IFFTitle THEN   (* this has to be set, too *)
  945.     WITH Info^ DO
  946.       TextBuffer^[0]  := "CMAP";
  947.       LONGBuffer^[1]  := CMAP.colorCnt * 3;
  948.       IF ODD(LONGBuffer^[1]) THEN INC(LONGBuffer^[1]) END;
  949.       FOR i:=0 TO CMAP.colorCnt-1 DO
  950.         BYTEBuffer^[ 8+3*i] := UByte(ORD(CMAP.red  [i]) * 16);
  951.         BYTEBuffer^[ 9+3*i] := UByte(ORD(CMAP.green[i]) * 16);
  952.         BYTEBuffer^[10+3*i] := UByte(ORD(CMAP.blue [i]) * 16);
  953.       END;
  954.       len := Write(OutH,Buffer,LONGBuffer^[1]+8);
  955.       INC(FileLength,LONGBuffer^[1]+8);
  956.     END;
  957.   END;
  958.  
  959. (*------  GRAB:  ------*)
  960.  
  961.   IF GRAB IN Info^.IFFTitle THEN
  962.     TextBuffer^[0] := "GRAB";
  963.     LONGBuffer^[1] := 8;
  964.     WORDBuffer^[4] := Info^.GRAB.hotX;
  965.     WORDBuffer^[5] := Info^.GRAB.hotY;
  966.     len := Write(OutH,Buffer,12);
  967.     INC(FileLength,12);
  968.   END;
  969.  
  970. (*------  DEST:  ------*)
  971.  
  972.   IF DEST IN Info^.IFFTitle THEN
  973.     TextBuffer^[0] := "DEST";
  974.     LONGBuffer^[1] := 8;
  975.     BYTEBuffer^[8] := Info^.DEST.depth;
  976.     BYTEBuffer^[9] := 0;
  977.     WORDBuffer^[5] := Info^.DEST.planePick;
  978.     WORDBuffer^[6] := Info^.DEST.planeOnOff;
  979.     WORDBuffer^[7] := Info^.DEST.planeMask;
  980.     len := Write(OutH,Buffer,16);
  981.     INC(FileLength,16);
  982.   END;
  983.  
  984. (*------  CAMG:  ------*)
  985.  
  986.   IF CAMG IN Info^.IFFTitle THEN
  987.     TextBuffer^[0] := "CAMG";
  988.     LONGBuffer^[1] := 4;
  989.     LONGBuffer^[2] := CAST(LONGCARD,Info^.CAMG.viewType);
  990.     len := Write(OutH,Buffer,12);
  991.     INC(FileLength,12);
  992.   END;
  993.  
  994. (*------  CRNG:  ------*)
  995.  
  996.   IF CRNG IN Info^.IFFTitle THEN
  997.     i := 0;
  998.     WHILE i<LONGINT(Info^.CRNG.count) DO
  999.       WITH Info^.CRNG.data[i] DO
  1000.         TextBuffer^[0] := "CRNG";
  1001.         LONGBuffer^[1] := 8;
  1002.         WORDBuffer^[4] := 0;
  1003.         WORDBuffer^[5] := rate;
  1004.         IF on THEN
  1005.           WORDBuffer^[6] := 1;
  1006.         ELSE
  1007.           WORDBuffer^[6] := 0;
  1008.         END;
  1009.         IF NOT(forward) THEN
  1010.           INC(WORDBuffer^[6],2);
  1011.         END;
  1012.         BYTEBuffer^[14] := low;
  1013.         BYTEBuffer^[15] := high;
  1014.         len := Write(OutH,Buffer,16);
  1015.         INC(FileLength,16);
  1016.       END;
  1017.       INC(i);
  1018.     END;
  1019.   END;
  1020.  
  1021. (*------  BODY:  ------*)
  1022.  
  1023.   BodyPos := FileLength;
  1024.   TextBuffer^[0] := "BODY";
  1025.   len := Write(OutH,Buffer,8);
  1026.   INC(FileLength,8);
  1027.   BodyLength := 0;
  1028.   i := 0;
  1029.   TrueLeftOffset := CAST(CARDINAL,CAST(BITSET,LeftOffset) * {4..15});
  1030.   TrueWidth := CAST(CARDINAL,CAST(BITSET,Info^.BMHD.width + 15) * {4..15});
  1031.  
  1032.   WHILE i<LONGINT(Info^.BMHD.depth) DO
  1033.     BitMaps[i] := BM^.planes[i];
  1034.     INC(BitMaps[i],FirstLine * LONGINT(BM^.bytesPerRow) +
  1035.                    TrueLeftOffset DIV 8);
  1036.     INC(i);
  1037.   END;
  1038.  
  1039.   LineLength := TrueWidth DIV 8;
  1040.  
  1041.   NeedToShift := (TrueLeftOffset # LeftOffset)
  1042.                   OR (TrueWidth # Info^.BMHD.width);
  1043.   IF NeedToShift THEN
  1044.     ShiftWidth := LeftOffset - TrueLeftOffset;
  1045.     BitsToShift := Info^.BMHD.width;
  1046.   END;
  1047.  
  1048.   IF CompressIt THEN
  1049.     Line := 0;
  1050.     WHILE Line<Info^.BMHD.height DO
  1051.       Plane := 0;
  1052.       WHILE Plane<LONGINT(Info^.BMHD.depth) DO
  1053.         IF NeedToShift THEN
  1054.           ShiftLine(BitMaps[Plane]);
  1055.           len := Compress(ADR(ShiftBuffer),LineLength);
  1056.         ELSE
  1057.           len := Compress(BitMaps[Plane],LineLength);
  1058.         END;
  1059.         INC(BitMaps[Plane],BM^.bytesPerRow);
  1060.         INC(Plane);
  1061.       END;
  1062.       INC(Line);
  1063.     END;
  1064.   ELSE
  1065.     Line := 0;
  1066.     WHILE Line<Info^.BMHD.height DO
  1067.       Plane := 0;
  1068.       WHILE Plane<LONGINT(Info^.BMHD.depth) DO
  1069.         IF NeedToShift THEN
  1070.           ShiftLine(BitMaps[Plane]);
  1071.           len := Write(OutH,ADR(ShiftBuffer),LineLength);
  1072.         ELSE
  1073.           len := Write(OutH,BitMaps[Plane],LineLength);
  1074.         END;
  1075.         INC(FileLength,LineLength);
  1076.         INC(BodyLength,LineLength);
  1077.         INC(BitMaps[Plane],BM^.bytesPerRow);
  1078.         INC(Plane);
  1079.       END;
  1080.       INC(Line);
  1081.     END;
  1082.   END;
  1083.   IF ODD(FileLength) THEN
  1084.     BYTEBuffer^[0] := 0;
  1085.     len := Write(OutH,Buffer,1);
  1086.     INC(FileLength);
  1087.   END;
  1088.  
  1089.   len := Seek(OutH,BodyPos+12,beginning);
  1090.   LONGBuffer^[0] := BodyLength;
  1091.   len := Write(OutH,Buffer,4);
  1092.  
  1093. (*------  Done:  ------*)
  1094.  
  1095.   len := Seek(OutH,4,beginning);
  1096.   LONGBuffer^[0] := FileLength;
  1097.   len := Write(OutH,Buffer,4);
  1098.   Close(OutH);
  1099.   OutH := NIL;
  1100.   IF len#4 THEN
  1101.     len := DeleteFile(ADR(Name));
  1102.     IFFError := iffReadWritefailed;
  1103.     RETURN FALSE;
  1104.   ELSE
  1105.     RETURN TRUE;
  1106.   END;
  1107. END WriteILBMAll;
  1108.  
  1109. (*-------------------------------------------------------------------------*)
  1110. (*                                                                         *)
  1111. (*                 Save a RastPort and ViewPort ILBM-File:                 *)
  1112. (*                                                                         *)
  1113. (*-------------------------------------------------------------------------*)
  1114.  
  1115. PROCEDURE WriteILBM(Name: ARRAY OF CHAR;
  1116.                     RP: RastPortPtr;
  1117.                     VP: ViewPortPtr;
  1118.                     Rect: RectanglePtr;
  1119.                     CompressIt: BOOLEAN): BOOLEAN;
  1120.  
  1121. (* Creates an ILBM-File                                                    *)
  1122. (* Name:       File's Name                                                 *)
  1123. (* RP:         RastPort containing the BitMap etc.                         *)
  1124. (* VP:         ViewPort containing the Colors, ViewModes etc.              *)
  1125. (* Rect:       The Rectangle Region in your RastPort, that should be saved *)
  1126. (*             or NIL to save hole RastPort                                *)
  1127. (* Compressit: Create compressed ILBM-File or not ?                        *)
  1128. (* Result is FALSE if any Error occured.                                   *)
  1129. (* example to save a Window:                                               *)
  1130. (*      OK := WriteILBM("Test.iff",                                        *)
  1131. (*                      MyWindow^.rPort,                                   *)
  1132. (*                      ADR(MyWindow^.screen^.viewPort,                    *)
  1133. (*                      TRUE);                                             *)
  1134.  
  1135. BEGIN
  1136.  
  1137.   InitIFFInfo(ADR(IFFInfo),RP,VP,Rect);
  1138.  
  1139.   RETURN WriteILBMAll(Name,ADR(IFFInfo),RP^.bitMap,
  1140.                       Rect^.minY,Rect^.minX,CompressIt);
  1141.  
  1142. END WriteILBM;
  1143.  
  1144. (*-------------------------------------------------------------------------*)
  1145. (*                                                                         *)
  1146. (*                    Save a Screen as ILBM-File:                          *)
  1147. (*                                                                         *)
  1148. (*-------------------------------------------------------------------------*)
  1149.  
  1150. PROCEDURE WriteILBMScreen(Name: ARRAY OF CHAR;
  1151.                           Screen: ScreenPtr;
  1152.                           Rect: RectanglePtr;
  1153.                           CompressIt: BOOLEAN): BOOLEAN;
  1154.  
  1155. (* This creates an ILBM-File from a Screen                                 *)
  1156. (* Name:       File's Name                                                 *)
  1157. (* Screen:     Screen to be saved                                          *)
  1158. (* Rect:       The Rectangle Region in your Screen, that should be saved   *)
  1159. (*             or NIL to save hole Screen                                  *)
  1160. (* CompressIt: Create a Compressed ILBM-File                               *)
  1161. (* Returns TRUE if no Error occured.                                       *)
  1162. (* example: OK := WriteILBMScreen("Test.iff",MyScreen,NIL,TRUE);           *)
  1163.  
  1164. BEGIN
  1165.  
  1166.   WITH Screen^ DO
  1167.     RETURN WriteILBM(Name,ADR(rastPort),ADR(viewPort),Rect,CompressIt);
  1168.   END;
  1169.  
  1170. END WriteILBMScreen;
  1171.  
  1172. (*------------------------  TermProcedure:  -------------------------------*)
  1173.  
  1174. PROCEDURE CleanUp();
  1175.  
  1176. BEGIN
  1177.   IF InH #NIL THEN Close(InH ) END;
  1178.   IF OutH#NIL THEN Close(OutH) END;
  1179.   FreeMem(Buffer,768);
  1180. END CleanUp;
  1181.  
  1182. (*-----------------------  Initialization:  -------------------------------*)
  1183.  
  1184. BEGIN
  1185.   Buffer := AllocMem(768,MemReqSet{chip,memClear});
  1186.   Assert(Buffer#NIL,ADR("Not enough ChipMem !!!"));
  1187.   TextBuffer := Buffer;
  1188.   LONGBuffer := Buffer;
  1189.   WORDBuffer := Buffer;
  1190.   BYTEBuffer := Buffer;
  1191.   RQBuffer := ADDRESS(Buffer+256);
  1192.   InH := NIL; OutH := NIL;
  1193.   FOR i:=0 TO 31 DO CycleInfos[i].VP:=NIL END;
  1194.   TermProcedure(CleanUp);
  1195. END IFFSupport.
  1196.